home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jedit_paren.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  4.8 KB  |  139 lines
  1. # jedit_paren.tcl - support for matching brackets in jedit
  2. #
  3. # These procedures are by David Svoboda <svoboda@ece.cmu.edu>, from the
  4. # Beth editor (the predecessor of Elsbeth).  They were borrowed and
  5. # modified by Christian Artigues <artigues@ensta.fr> and Maurice
  6. # Diamantini <diam@ensta.fr> for the STEAD editor (based on jedit), and
  7. # I'm incorporating them back into jedit (somewhat modified), with David's
  8. # permission.
  9. # 
  10. # I don't have the original copyright information for Beth, but
  11. # Elsbeth's copyright is:
  12. #
  13. #   Elsbeth & Teacher Hypertools: Copyright (c) 1994  David Svoboda
  14. # 
  15. # (and this code is very similar to the code in the current version of
  16. # Elsbeth).  There's an Elsbeth home page at
  17. #
  18. # http://www.ece.cmu.edu/afs/ece/usr/svoboda/www/elsbeth/homepage.html
  19.  
  20. # TO DO:
  21. # * make searching for matches much more efficient (what if you're at
  22. #   the end of a 1Mb document?
  23. # * maybe these procedures should be merged into the bindings libraries
  24.  
  25. ######################################################################
  26. # jedit:balance_bind t -
  27. #   set up bindings to balance parentheses etc. in $t
  28. #   (this procedure is from STEAD)
  29. ######################################################################
  30.  
  31. proc jedit:balance_bind { t } {
  32.   global jedit_balance_list
  33.   
  34.   set jedit_balance_list \
  35.     {{\( \) parenright} {\[ \] bracketright} {\{ \} braceright}}
  36.   
  37.   foreach pair $jedit_balance_list {
  38.     set left_char [lindex $pair 0]
  39.     set right_char [lindex $pair 1]        ;# unused
  40.     set right_keysym [lindex $pair 2]
  41.     bind $t <$right_keysym> \
  42.       "j:tkb:self_insert %W %K %A;
  43.       jedit:paren:flash_left_paren %W \\$left_char %A"
  44.   }
  45. }
  46.  
  47. ######################################################################
  48. # jedit:paren:find_left_paren t left right close_trace -
  49. #   return index of matching left partner, or "" if unsuccessful.
  50. #   (this procedure is from Beth)
  51. ######################################################################
  52.  
  53. proc jedit:paren:find_left_paren {t left right close_trace} {
  54.   set left [string trimleft $left \\]
  55.   set right [string trimleft $right \\]
  56.   # set close_trace [$t index "$index -1 chars"]
  57.   set open_trace $close_trace
  58.   while (1) {
  59.     update
  60.     # go back 1 left, quit if none found.
  61.     set backset [string last $left [$t get 1.0 $open_trace]]
  62.     if {($backset < 0)} {return ""}
  63.     set open_trace [$t index "1.0 +$backset chars"]
  64.     # go back 1 right, if none after open, return current open
  65.     set offset [string last $right [$t get \
  66.       $open_trace $close_trace]]
  67.     if {($offset < 0)} {return $open_trace}
  68.     set close_trace [$t index "$open_trace +$offset chars"]
  69.   }
  70. }
  71.  
  72. ######################################################################
  73. # jedit:paren:char_count t c start end -
  74. #   counts instances of $c between $start and $end in $t
  75. #   (this procedure is from Beth)
  76. ######################################################################
  77.  
  78. proc jedit:paren:char_count {t c start end} {
  79.   set offset 0
  80.   set count 0
  81.   set c [string trimleft $c \\]
  82.   
  83.   while {[set offset [string first $c [$t get $start $end]]] >= 0} {
  84.     incr count
  85.     set start [$t index "$start +$offset chars +1 chars"]
  86.   }
  87.   return $count
  88. }
  89.  
  90. ######################################################################
  91. # jedit:paren:balance_count t left right start end -
  92. #   checks if $left and $right occur same # of times in [$start $end] of $t
  93. #   (this procedure is from Beth)
  94. ######################################################################
  95.  
  96. proc jedit:paren:balance_count {t left right start end} {
  97.   set c1 [jedit:paren:char_count $t $left $start $end]
  98.   set c2 [jedit:paren:char_count $t $right $start $end]
  99.   
  100.   if {($c1 > $c2)} {return "[string trimleft $left \\] [expr $c1-$c2]"}
  101.   if {($c2 > $c1)} {return "[string trimleft $right \\] [expr $c2-$c1]"}
  102.   return ""
  103. }
  104.  
  105. ######################################################################
  106. # jedit:paren:flash_left_paren t left right
  107. #   flash left partner of character $left in text $t, or beep if none
  108. #   (this procedure is from STEAD)
  109. ######################################################################
  110.  
  111. proc jedit:paren:flash_left_paren {t left right} {
  112.   set result [jedit:paren:find_left_paren \
  113.     $t $left $right [$t index "insert -1 chars"]]
  114.   if {($result == "")} {        ;# not found
  115.     j:beep $t
  116.   } else {
  117.     jedit:flash $t $result "$result +1 chars"
  118.   }
  119. }
  120.  
  121. ######################################################################
  122. # jedit:flash t from to - flash a range briefly
  123. ######################################################################
  124.  
  125. proc jedit:flash {t from to} {
  126.   global JEDIT_PREFS
  127.   
  128.   set bg $JEDIT_PREFS(textbg)
  129.   set fg $JEDIT_PREFS(textfg)
  130.   
  131.   $t tag configure jedit_paren_match -background $fg -foreground $bg
  132.   $t tag raise jedit_paren_match
  133.   
  134.   $t tag add jedit_paren_match $from $to
  135.   update
  136.   
  137.   after 200 "$t tag delete jedit_paren_match"
  138. }
  139.